home *** CD-ROM | disk | FTP | other *** search
/ PCMania 64 / PCMania CD64_1.iso / phy / phy003 / 3d / stars.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-04-07  |  1.6 KB  |  83 lines
  1. {By Skynet....From Vulkanus
  2. "My computer, My hero, My God, My I"
  3.  
  4. Crec en la vostra comprensio...}
  5.  
  6. Program Ta_Mare_No_Te_Coll;
  7.  
  8. Uses Crt,Grflib;
  9.  
  10. Const ESTEL=500;
  11.  
  12. Type estels=Array[1..ESTEL] of word;
  13.  
  14. Var X,Y,Z    :Estels;
  15.     Car      :Char;
  16.     PV       :Byte;
  17.     a,b      :Integer;
  18.  
  19. Const DIST:Integer=1024;
  20.  
  21. Procedure GoStar(MW:Word); Forward;
  22.  
  23. Procedure Putpixel3D(Xc,Yc,Zc,orx,ory:Integer; Color:Byte; SE,Index:Word);
  24.    Var RX,RY:Integer;
  25.     begin
  26.       if zc<1 then zc:=1;
  27.       RX:=(Xc*dist div (zc+1))+orx;
  28.       RY:=(Yc*dist div (zc+1))+ory;
  29.       if ((rx>0) and (rx<319)) AND ((ry>0) and (ry<199)) then
  30.         fponpixel(rx,ry,color,pv)
  31.       Else
  32.         GoStar(Index);
  33.     End;
  34.  
  35. Procedure Initstars;
  36.    Var i:Integer;
  37.     Begin
  38.        for i:=1 to ESTEL do
  39.         Begin
  40.          X[i]:=Random(319) +1;
  41.          Y[i]:=Random(199) +1;
  42.          Z[i]:=Random(Dist)+1;
  43.         End;
  44.     End;
  45.  
  46. Procedure PutStars(Se:Word;orx,ory:integer);
  47.    Var I:Integer;
  48.      Begin
  49.        For I:=1 to ESTEL do
  50.          Begin
  51.            If Z[i]<500 then
  52.               PutPixel3D(X[i],Y[i],Z[i],orx,ory,15,se,i)
  53.            else
  54.               Putpixel3D(X[i],Y[i],Z[i],orx,ory,8,se,i);
  55.            Z[i]:=Z[i]-2;
  56.          End;
  57.      End;
  58.  
  59. Procedure GoStar(MW:Word);
  60.   Var I:Integer;
  61.    Begin
  62.     X[mW]:=Random(318)+1;
  63.     Y[mW]:=Random(198)+1;
  64.     Z[mW]:=Random(Dist);
  65.    End;
  66.  
  67.  
  68. BEGIN
  69.   Modografico;
  70.   borrapantalla(0,0);
  71.   PV:=CreaVirtual;
  72.   Initstars;
  73.   Car:=#0;
  74.   a:=160;
  75.   b:=100;
  76.   Repeat
  77.     fborrapantalla(0,pv);
  78.     putstars(pv,a,b);
  79.     copiapantalla(pv,0);
  80.   Until keypressed;
  81.   Modotexto;
  82. END.
  83.